home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl720 / qbscr2j.lzh / MAKEMENU.BAS < prev    next >
BASIC Source File  |  1992-07-08  |  18KB  |  399 lines
  1. FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, divider$, fg%, bg%, hfg%, hBG%, qfg%, qbg%, useMouse%)
  2.  
  3.   '┌────────────────────────────────────────────────────────────────────────┐
  4.   '│  The MakeMenu function displays a menu list on the screen and allows   │
  5.   '│  the user to move a scrolling selection bar to highlight the entry of  │
  6.   '│  their choice.  Selection is made by hitting the ENTER key.  Other     │
  7.   '│  allowable keys include Home or PgUp to move to the first menu entry,  │
  8.   '│  and End or PgDn to move to the last entry.  Scroll bar wraps from top │
  9.   '│  to bottom and bottom to top.  The function returns as a value the     │
  10.   '│  position of the entry in the list of the user's selection.  For ex-   │
  11.   '│  ample, if the user selected the third item in a list of eight, the    │
  12.   '│  function would return a value of three.  Parameters for this function │
  13.   '│  are:                                                                  │
  14.   '│                                                                        │
  15.   '│  choice$() - An array of strings that contains the actual menu         │
  16.   '│              entries.  Example: Choice$(1) = 'Menu selcection 1'.      │
  17.   '│              Strings must be 78 characters or less in length.          │
  18.   '│  numOfChoices% - The number of menu choices available.  The same as    │
  19.   '│                  the number of elements in Choices$().  Allowable      │
  20.   '│                  range is 1 through 25.                                │
  21.   '│  justify$ - This string will contain a single letter, either an L, C,  │
  22.   '│             or a R.  L means left-justify the menu entries.  C means   │
  23.   '│             center them with respect to the left and right sides of    │
  24.   '│             the menu (see LeftColumn and RightColumn parameters below) │
  25.   '│             and an R means right-justify the menu entries.             │
  26.   '│  leftColumn - A numerical value containing the left-most column on     │
  27.   '│               which menu entries will be displayed.  Allowable range   │
  28.   '│               is 1 though 76.                                          │
  29.   '│  rightColumn - A numerical value containing the right-most column on   │
  30.   '│                which menu entries will be displayed.  Allowable range  │
  31.   '│                is 5 through 80.                                        │
  32.   '│  row% - A numerical value containing the first row on which to display │
  33.   '│         menu entries.  Allowable range is 1 through 24.                │
  34.   '│  marker$ - The character used in the menu entry strings that indicates │
  35.   '│            the next character is a 'Quick Access' key.                 │
  36.   '│  divider$ - The character used as a menu entry if a dividing line is   │
  37.   '│             desired.
  38.   '│  fg% - The foreground color of normal menu entries.  Allowable range   │
  39.   '│        is 0 to 15.                                                     │
  40.   '│  bg% - The background color of normal menu entries.  Allowable range   │
  41.   '│        is 0 to 7.                                                      │
  42.   '│  hfg% - The foreground color of the highlighted menu entry.  Allowable │
  43.   '│         range is 0 to 15.                                              │
  44.   '│  hbg% - The background color of the highlighted menu entry.  Allowable │
  45.   '│         range is 0 to 7.                                               │
  46.   '│  qfg% - The foreground color of the Quick Access keys.  Allowable      │
  47.   '│         range is 0 to 15.                                              │
  48.   '│  qbg% - The background color of the Quick Access keys.  Allowable      │
  49.   '│         range is 0 to 7.                                               │
  50.   '│  useMouse% - 1 = use mouse support, 0 = don't.
  51.   '└────────────────────────────────────────────────────────────────────────┘
  52.  
  53.   '─────────────────────────────────────────────────────────────────────────
  54.   ' Set local variables - extended scan codes for keypad keys
  55.   '─────────────────────────────────────────────────────────────────────────
  56.     up$ = CHR$(0) + CHR$(72)
  57.     down$ = CHR$(0) + CHR$(80)
  58.     enter$ = CHR$(13)
  59.     home$ = CHR$(0) + CHR$(71)
  60.     EndKee$ = CHR$(0) + CHR$(79)
  61.     PgUpKey$ = CHR$(0) + CHR$(73)
  62.     PgDnKey$ = CHR$(0) + CHR$(81)
  63.     esc$ = CHR$(27)
  64.  
  65.   '─────────────────────────────────────────────────────────────────────────
  66.   ' Define other local variables.
  67.   '─────────────────────────────────────────────────────────────────────────
  68.     mx% = 0
  69.     my% = 0
  70.     lmCnt% = 0
  71.     rmCnt% = 0
  72.     returnIt% = FALSE
  73.     updateMenu% = FALSE
  74.  
  75.   '─────────────────────────────────────────────────────────────────────────
  76.   ' Define the error tone string to use with PLAY
  77.   '─────────────────────────────────────────────────────────────────────────
  78.     errorTone$ = "MB T120 L50 O3 AF"
  79.  
  80.   '─────────────────────────────────────────────────────────────────────────
  81.   ' Set type of justification to uppercase
  82.   '─────────────────────────────────────────────────────────────────────────
  83.     justify$ = UCASE$(justify$)
  84.     wdth% = (rightColumn - leftColumn - 1)
  85.  
  86.   '─────────────────────────────────────────────────────────────────────────
  87.   ' Check for out-of-bounds parameters.  If any are out of range,
  88.   ' quit the function
  89.   '─────────────────────────────────────────────────────────────────────────
  90.     IF numOfChoices% < 1 OR numOfChoices% > 25 THEN EXIT FUNCTION
  91.     IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION
  92.     IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION
  93.     IF row% < 1 OR row% > 24 THEN EXIT FUNCTION
  94.  
  95.   '─────────────────────────────────────────────────────────────────────────
  96.   ' Calculate the array of character identifiers
  97.   '─────────────────────────────────────────────────────────────────────────
  98.     REDIM charID(numOfChoices%) AS STRING * 1
  99.     FOR x% = 1 TO numOfChoices%
  100.       FOR y% = 1 TO LEN(choice$(x%))
  101.         IF MID$(choice$(x%), y%, 1) = marker$ THEN
  102.           charID(x%) = UCASE$(MID$(choice$(x%), y% + 1, 1))
  103.           EXIT FOR
  104.         END IF
  105.       NEXT y%
  106.     NEXT x%
  107.  
  108.   '─────────────────────────────────────────────────────────────────────────
  109.   ' Calculate length of longest menu choice and store value in ChoiceLen%
  110.   '─────────────────────────────────────────────────────────────────────────
  111.     choiceLen% = 0
  112.     FOR x% = 1 TO numOfChoices%
  113.       IF LEN(choice$(x%)) > choiceLen% THEN
  114.         IF INSTR(choice$(x%), marker$) THEN
  115.           choiceLen% = LEN(choice$(x%))
  116.         ELSE
  117.           choiceLen% = LEN(choice$(x%)) + 1
  118.         END IF
  119.       END IF
  120.     NEXT x%
  121.     choiceLen% = choiceLen% - 1
  122.  
  123.   '─────────────────────────────────────────────────────────────────────────
  124.   ' Determine left-most column to display highlight bar on
  125.   '─────────────────────────────────────────────────────────────────────────
  126.     col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn
  127.  
  128.   '─────────────────────────────────────────────────────────────────────────
  129.   ' At this point, we must turn off the mouse cursor if it's available.  We
  130.   ' don't want to write overtop of it, leaving a hole when it's moved later.
  131.   '─────────────────────────────────────────────────────────────────────────
  132.     IF useMouse% THEN
  133.       MouseHide
  134.     END IF
  135.  
  136.   '─────────────────────────────────────────────────────────────────────────
  137.   ' Print menu choices to screen based on the type of Justification
  138.   ' selected (Center, Left, Right).
  139.   '─────────────────────────────────────────────────────────────────────────
  140.     COLOR fg%, bg%
  141.     SELECT CASE justify$
  142.     CASE "C"
  143.       FOR x% = 1 TO numOfChoices%
  144.         xCol% = ((wdth% - (LEN(choice$(x%))) - 1) \ 2 + leftColumn) + 1
  145.         LOCATE (row% - 1) + x%, leftColumn - 1, 0
  146.         PRINT SPACE$(choiceLen% + 2);
  147.         LOCATE (row% - 1) + x%, xCol%, 0
  148.         DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  149.       NEXT x%
  150.     CASE "R"
  151.       FOR x% = 1 TO numOfChoices%
  152.         LOCATE (row% - 1) + x%, leftColumn - 1, 0
  153.         PRINT SPACE$(choiceLen% + 2);
  154.         LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(x%)))
  155.         DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  156.       NEXT x%
  157.     CASE "L"
  158.       FOR x% = 1 TO numOfChoices%
  159.         LOCATE (row% - 1) + x%, leftColumn - 1, 0
  160.         PRINT SPACE$(choiceLen% + 2);
  161.         LOCATE (row% - 1) + x%, leftColumn, 0
  162.         DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  163.       NEXT x%
  164.     END SELECT
  165.  
  166.   '─────────────────────────────────────────────────────────────────────────
  167.   ' Highlight the first entry in the list.  Must take into account the
  168.   ' justification type.
  169.   '─────────────────────────────────────────────────────────────────────────
  170.     currentLocation% = 1
  171.     oldLocation% = 1
  172.     COLOR hfg%, hBG%
  173.     LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  174.     SELECT CASE justify$
  175.     CASE "C"
  176.       xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  177.       LOCATE (row% - 1 + currentLocation%), xCol%, 0
  178.       DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  179.     CASE "R"
  180.       LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  181.       DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  182.     CASE "L"
  183.       LOCATE (row% - 1) + currentLocation%, leftColumn
  184.       DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  185.     END SELECT
  186.  
  187.   '─────────────────────────────────────────────────────────────────────────
  188.   ' Read keystrokes and change the highlighted entry appropriately.  Also
  189.   ' drain out any pending mouse button presses if the mouse is available.
  190.   '─────────────────────────────────────────────────────────────────────────
  191.     exitCode% = FALSE
  192.     IF useMouse% THEN
  193.       MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my%
  194.       MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my%
  195.       lmCnt% = 0
  196.       rmCnt% = 0
  197.     END IF
  198.     WHILE exitCode% = FALSE
  199.  
  200.     '─────────────────────────────────────────────────────────────────────
  201.     ' If we're using the mouse, turn it on.
  202.     '─────────────────────────────────────────────────────────────────────
  203.       IF useMouse% THEN
  204.         MouseShow
  205.       END IF
  206.  
  207.     '─────────────────────────────────────────────────────────────────────
  208.     ' Read keystrokes and/or mouse presses.
  209.     '─────────────────────────────────────────────────────────────────────
  210.       key$ = ""
  211.       lmCnt% = 0
  212.       rmCnt% = 0
  213.       IF useMouse% THEN
  214.         MouseButtonPressInfo RIGHTBUTTON, rmCnt%, mx%, my%
  215.         MouseButtonPressInfo LEFTBUTTON, lmCnt%, mx%, my%
  216.  
  217.       '───────────────────────────────────────────────────────────────────
  218.       ' Did we have any left mouse button presses?  If not, check the
  219.       ' keyboard for input.
  220.       '───────────────────────────────────────────────────────────────────
  221.         IF lmCnt% = 0 THEN
  222.           key$ = UCASE$(INKEY$)
  223.         END IF
  224.       ELSE
  225.  
  226.       '───────────────────────────────────────────────────────────────────
  227.       ' No mouse available, so wait for keyboard input.
  228.       '───────────────────────────────────────────────────────────────────
  229.         WHILE key$ = ""
  230.           key$ = UCASE$(INKEY$)
  231.         WEND
  232.       END IF
  233.  
  234.     '─────────────────────────────────────────────────────────────────────
  235.     ' If the left mouse button was pressed, check to see if a menu item
  236.     ' was selected by it.
  237.     '─────────────────────────────────────────────────────────────────────
  238.       IF (useMouse%) AND (lmCnt% > 0) THEN
  239.  
  240.       '───────────────────────────────────────────────────────────────────
  241.       ' Convert virtual screen mouse coordinates to real 80x25 coords.
  242.       '───────────────────────────────────────────────────────────────────
  243.         mx% = (mx% \ 8) + 1
  244.         my% = (my% \ 8) + 1
  245.  
  246.       '───────────────────────────────────────────────────────────────────
  247.       ' If mouse was inside menu window then return the item pointed to.
  248.       '───────────────────────────────────────────────────────────────────
  249.         IF (mx% >= leftColumn) AND (mx% <= rightColumn) AND (my% >= row%) AND (my% <= row% + numOfChoices% - 1) THEN
  250.           IF (choice$(my% - row% + 1) <> divider$) THEN
  251.             exitCode% = TRUE
  252.             updateMenu% = TRUE
  253.             currentLocation% = my% - row% + 1
  254.             key$ = charID(currentLocation%)
  255.             returnIt% = TRUE
  256.           END IF
  257.         END IF
  258.       END IF
  259.  
  260.     '─────────────────────────────────────────────────────────────────────
  261.     ' If right mouse button was pressed, then exit as if ESC were pressed.
  262.     '─────────────────────────────────────────────────────────────────────
  263.     IF (useMouse%) AND (rmCnt% > 0) THEN
  264.       MakeMenu% = 0
  265.       EXIT FUNCTION
  266.     END IF
  267.  
  268.     '───────────────────────────────────────────────────────────────────
  269.     ' Update currentLocation based on what user did, key-wise.
  270.     '───────────────────────────────────────────────────────────────────
  271.       SELECT CASE key$
  272.  
  273.       CASE up$
  274.         IF currentLocation% > 1 THEN
  275.           currentLocation% = currentLocation% - 1
  276.           IF (choice$(currentLocation%) = divider$) AND (currentLocation% > 0) THEN
  277.             currentLocation% = currentLocation% - 1
  278.           END IF
  279.         ELSE
  280.           currentLocation% = numOfChoices%
  281.         END IF
  282.         updateMenu% = TRUE
  283.  
  284.       CASE down$
  285.         IF currentLocation% < numOfChoices% THEN
  286.           currentLocation% = currentLocation% + 1
  287.           IF (choice$(currentLocation%) = divider$) AND (currentLocation% < numOfChoices%) THEN
  288.             currentLocation% = currentLocation% + 1
  289.           END IF
  290.         ELSE
  291.           currentLocation% = 1
  292.         END IF
  293.         updateMenu% = TRUE
  294.  
  295.       CASE home$, PgUpKey$
  296.         IF currentLocation% <> 1 THEN
  297.           currentLocation% = 1
  298.           updateMenu% = TRUE
  299.         END IF
  300.  
  301.       CASE EndKee$, PgDnKey$
  302.         IF currentLocation% <> numOfChoices% THEN
  303.           currentLocation% = numOfChoices%
  304.           updateMenu% = TRUE
  305.         END IF
  306.  
  307.       CASE enter$
  308.         MakeMenu% = currentLocation%
  309.         exitCode% = TRUE
  310.  
  311.       CASE esc$
  312.         MakeMenu% = 0
  313.         exitCode% = TRUE
  314.  
  315.       CASE ELSE
  316.       '───────────────────────────────────────────────────────────────────
  317.       ' Check quick access keys.
  318.       '───────────────────────────────────────────────────────────────────
  319.         FOR i% = 1 TO numOfChoices%
  320.           IF charID(i%) = key$ THEN
  321.             currentLocation% = i%
  322.             updateMenu% = TRUE
  323.             MakeMenu% = i%
  324.             exitCode% = TRUE
  325.           END IF
  326.         NEXT i%
  327.  
  328.       END SELECT
  329.  
  330.     '───────────────────────────────────────────────────────────────────
  331.     ' If required, update the display.
  332.     '───────────────────────────────────────────────────────────────────
  333.       IF updateMenu% THEN
  334.  
  335.       '───────────────────────────────────────────────────────────────────
  336.       ' If mouse is around, turn it off, since we'll be displaying.
  337.       '───────────────────────────────────────────────────────────────────
  338.         IF useMouse% THEN
  339.           MouseHide
  340.         END IF
  341.  
  342.       '─────────────────────────────────────────────────────────────────
  343.       ' Restore the old highlighted item to normal colors.
  344.       '─────────────────────────────────────────────────────────────────
  345.         COLOR fg%, bg%
  346.         LOCATE row% + oldLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  347.         SELECT CASE justify$
  348.         CASE "C"
  349.           xCol% = ((wdth% - (LEN(choice$(oldLocation%))) - 1) \ 2 + leftColumn) + 1
  350.           LOCATE (row% - 1 + oldLocation%), xCol%, 0
  351.           DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  352.         CASE "R"
  353.           LOCATE (row% - 1) + oldLocation%, (rightColumn - LEN(choice$(oldLocation%)))
  354.           DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  355.         CASE "L"
  356.           LOCATE (row% - 1) + oldLocation%, leftColumn
  357.           DisplayEntry choice$(oldLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 1
  358.         END SELECT
  359.  
  360.       '─────────────────────────────────────────────────────────────────
  361.       ' Display newly highlighted item in highlight colors.
  362.       '─────────────────────────────────────────────────────────────────
  363.         COLOR hfg%, hBG%
  364.         LOCATE row% + currentLocation% - 1, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  365.         SELECT CASE justify$
  366.         CASE "C"
  367.           xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  368.           LOCATE (row% - 1 + currentLocation%), xCol%, 0
  369.           DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  370.         CASE "R"
  371.           LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  372.           DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  373.         CASE "L"
  374.           LOCATE (row% - 1) + currentLocation%, leftColumn
  375.           DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hBG%, fg%, bg%, marker$, divider$, wdth%, 2
  376.         END SELECT
  377.  
  378.       '─────────────────────────────────────────────────────────────────
  379.       ' Reset old location to current.
  380.       '─────────────────────────────────────────────────────────────────
  381.         oldLocation% = currentLocation%
  382.         updateMenu% = FALSE
  383.  
  384.       END IF
  385.  
  386.     '───────────────────────────────────────────────────────────────────
  387.     ' If the mouse was used to click on a menu choice, then return it
  388.     ' and exit now.
  389.     '───────────────────────────────────────────────────────────────────
  390.       IF returnIt% THEN
  391.         MakeMenu% = currentLocation%
  392.         EXIT FUNCTION
  393.       END IF
  394.  
  395.     WEND
  396.  
  397. END FUNCTION
  398.  
  399.